home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / ISSUE13 / IDAPI / BDE01.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-04-24  |  2.6 KB  |  114 lines

  1. unit Bde01;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, Menus,
  8.   StdCtrls, DbiTypes, DbiProcs;
  9.  
  10. type
  11.   TForm2 = class(TForm)
  12.     DataSource1: TDataSource;
  13.     Table1: TTable;
  14.     DBGrid1: TDBGrid;
  15.     DBNavigator1: TDBNavigator;
  16.     MainMenu1: TMainMenu;
  17.     Panel2: TPanel;
  18.     Label1: TLabel;
  19.     Edit1: TEdit;
  20.     Label2: TLabel;
  21.     Edit2: TEdit;
  22.     File1: TMenuItem;
  23.     Gotorecord1: TMenuItem;
  24.     Moveby1: TMenuItem;
  25.     N1: TMenuItem;
  26.     Exit1: TMenuItem;
  27.     SetPrivDir: TMenuItem;
  28.     N2: TMenuItem;
  29.     procedure DataSource1DataChange(Sender: TObject; Field: TField);
  30.     procedure Gotorecord1Click(Sender: TObject);
  31.     procedure Moveby1Click(Sender: TObject);
  32.     procedure Exit1Click(Sender: TObject);
  33.     procedure SetPrivDirClick(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     { Public declarations }
  38.   end;
  39.  
  40. var
  41.   Form2: TForm2;
  42.  
  43. function GetRecNo(ATable: TTable): LongInt;
  44.  
  45. implementation
  46. uses CpyRen, ChDir;
  47.  
  48. {$R *.DFM}
  49.  
  50. function GetRecNo(ATable: TTable): LongInt;
  51. var Props:  CURProps;
  52.     RProps: RECProps;
  53. begin
  54.   Result := -1;
  55.  
  56.   Check(DbiGetCursorProps(ATable.Handle, Props));
  57.   ATable.UpdateCursorPos;
  58.   Check(DbiGetRecord(ATable.Handle, dbiNOLOCK, nil, @RProps));
  59.  
  60.   if (Props.iSeqNums = 1) then
  61.     Result :=  RProps.iSeqNum
  62.   else
  63.     if (Props.iSeqNums = 0) then
  64.       Result := RProps.iPhyRecNum
  65. end;
  66.  
  67. procedure TForm2.DataSource1DataChange(Sender: TObject; Field: TField);
  68. var RecNo: LongInt;
  69.     TranInfo: XInfo;
  70. begin
  71.   Table1.UpdateCursorPos;
  72.   Edit1.Text := IntToStr(GetRecNo(Table1));
  73. end;
  74.  
  75. procedure TForm2.Gotorecord1Click(Sender: TObject);
  76. begin
  77.   Check(DbiSetToSeqNo(Table1.Handle, StrToInt(Edit1.Text)));
  78.   Table1.Refresh;
  79. end;
  80.  
  81. procedure TForm2.Moveby1Click(Sender: TObject);
  82. begin
  83.   Table1.UpdateCursorPos;
  84.   Check(DbiGetRelativeRecord(Table1.Handle, StrToInt(Edit2.Text), dbiNoLock, nil, nil));
  85.   Table1.Refresh;
  86. end;
  87.  
  88. procedure TForm2.Exit1Click(Sender: TObject);
  89. begin
  90.   Close;
  91. end;
  92.  
  93. procedure TForm2.SetPrivDirClick(Sender: TObject);
  94. var szDir: array[0..DBIMAXPATHLEN] of char;
  95. begin
  96.   try
  97.    Table1.DisableControls;
  98.    Table1.Close;
  99.    ChDirDlg := TChDirDlg.Create(Self);
  100.    if ChDirDlg.ShowModal = mrOK then
  101.    begin
  102.      StrPCopy(szDir, ChDirDlg.Label1.Caption);
  103.      Check(DbiSetPrivateDir(szDir));           
  104.    end;
  105.   except
  106.    Application.HandleException(Self);
  107.   end;
  108.   ChDirDlg.Release;
  109.   Table1.Open;
  110.   Table1.EnableControls;
  111. end;
  112.  
  113. end.
  114.